g +
geom_hline(yintercept = optimum$Time, linetype = 2) +
geom_vline(xintercept = optimum$Temperature, linetype = 2)
optimum <-
newdata |>
filter(bond >= 84, bond <= 86) |>
filter(print == max(print))
optimum <-
newdata |>
filter(bond >= 84, bond <= 86) |>
filter(print == max(print))
optimum |> pander()
g +
geom_hline(yintercept = optimum$Time, linetype = 2) +
geom_vline(xintercept = optimum$Temperature, linetype = 2)
optimum <-
newdata |>
filter(bond >= 84, bond <= 86) |>
filter(print == max(print))
optimum |> pander()
g +
geom_hline(yintercept = optimum$Time, linetype = 2) +
geom_vline(xintercept = optimum$Temperature, linetype = 2)
optimum <-
newdata |>
filter(bond >= 84, bond <= 86) |>
filter(print == max(print))
g +
geom_hline(yintercept = optimum$Time, linetype = 2) +
geom_vline(xintercept = optimum$Temperature, linetype = 2) +
geom_point(data = optimum, size = 3, shape = 4)
g +
geom_hline(yintercept = optimum$Time, linetype = 2) +
geom_vline(xintercept = optimum$Temperature, linetype = 2) +
geom_point(data = optimum, size = 3)
delta <- 0.5
optimum <-
newdata |>
filter(bond >= 85 - delta, bond <= 85 + delta) |>
filter(print == max(print))
optimum |> pander()
g +
geom_hline(yintercept = optimum$Time, linetype = 2) +
geom_vline(xintercept = optimum$Temperature, linetype = 2) +
geom_point(data = optimum, size = 3)
val_df <- read_delim("data/Validation_3 .csv", delim = ";")
df <-
bind_rows(
ccd_df |> mutate(type = "experiment"),
val_df |> mutate(type = "validation")
)
df
df <-
bind_rows(
ccd_df |> mutate(type = "experiment"),
val_df |> mutate(type = "validation")
) |>
mutate(n = row_number())
df |>
pivot_longer(cols = c(Bond, Print), names_to = "response", values_to = "value")
df |>
pivot_longer(cols = c(Bond, Print), names_to = "response", values_to = "value") |>
ggplot(aes(x = n, y = value, col = type)) +
geom_point() +
facet_wrap(~response, scales = "free_y")
df |>
pivot_longer(cols = c(Bond, Print), names_to = "response", values_to = "value") |>
ggplot(aes(x = n, y = value, col = type)) +
geom_point() +
facet_wrap(response ~ ., scales = "free_y")
df |>
pivot_longer(cols = c(Bond, Print), names_to = "response", values_to = "value") |>
ggplot(aes(x = n, y = value, col = type)) +
geom_point() +
facet_grid(response ~ ., scales = "free_y")
df |>
ggplot(aes(x = n, y = Bond, col = type)) +
geom_point()
df <-
bind_rows(
ccd_df |> mutate(type = "experiment"),
val_df |> mutate(type = "validation")
) |>
mutate(trial = row_number())
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_point()
df <-
bind_rows(
ccd_df |> mutate(type = "experiment"),
val_df |> mutate(type = "validation")
) |>
mutate(trial = row_number())
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_point()
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85, linetype = 2) +
geom_point()
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85 + c(-1, 0, 1) & delta, linetype = 2) +
geom_point()
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85 + c(-1, 0, 1) * delta, linetype = 2) +
geom_point()
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85 + c(-1, 1) * delta, linetype = 2) +
geom_point()
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85 + c(-1, 1), linetype = 3) +
geom_point()
df |>
ggplot(aes(x = trial, y = Print, col = type)) +
geom_hline(yintercept = 85 + c(-1, 1), linetype = 3) +
geom_point()
df |>
ggplot(aes(x = trial, y = Print, col = type)) +
geom_point()
library(tidyverse)
library(magrittr)
library(rsm)
library(scales)
library(pander)
library(plotly)
library(patchwork)
theme_set(theme_bw())
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85 + c(-1, 1), linetype = 3) +
geom_point()  +
df |>
ggplot(aes(x = trial, y = Print, col = type)) +
geom_point()
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85 + c(-1, 1), linetype = 3) +
geom_point()  +
df |>
ggplot(aes(x = trial, y = Print, col = type)) +
geom_point() +
plot_layout(guides = "collect")
df <-
bind_rows(
ccd_df |> mutate(type = "experiment"),
val_df |> mutate(type = "validation")
) |>
mutate(trial = row_number() |> factor())
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85 + c(-1, 1), linetype = 3) +
geom_point()  +
df |>
ggplot(aes(x = trial, y = Print, col = type)) +
geom_point() +
plot_layout(guides = "collect")
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85 + c(-1, 1), linetype = 3) +
geom_point(size = 2)  +
df |>
ggplot(aes(x = trial, y = Print, col = type)) +
geom_point(size = 2)  +
plot_layout(guides = "collect")
t.test(val_df$Bond, mu = 85, alternative = "two.sided", conf.level = 0.95)
newdata |>
ggplot(aes(x = Temperature, y = Time)) +
geom_tile(aes(fill = bond)) +
scale_fill_gradient2(low = "tomato", mid = "steelblue1", high = "black", midpoint = 85) +
geom_contour(aes(z = bond), color = "white", binwidth = 10)
bond_wide <-
newdata |>
select(-Pressure) |>
pivot_wider(names_from = Time, values_from = bond) |>
select(-Temperature) |>
as.matrix()
plot_ly(x = unique(newdata$Temperature), y = unique(newdata$Time), z = bond_wide) |>
add_surface() |>
layout(
scene =
list(
xaxis = list(title = "Temperature"),
yaxis = list(title = "Time"),
zaxis = list(title = "Bond")
)
)
bond_wide |> dim()
bond_wide <-
newdata |>
select(Temperature, Time, bond) |>
pivot_wider(names_from = Time, values_from = bond) |>
select(-Temperature) |>
as.matrix()
bond_wide |> dim()
plot_ly(x = unique(newdata$Temperature), y = unique(newdata$Time), z = bond_wide) |>
add_surface() |>
layout(
scene =
list(
xaxis = list(title = "Temperature"),
yaxis = list(title = "Time"),
zaxis = list(title = "Bond")
)
)
newdata |>
ggplot(aes(x = Temperature, y = Time)) +
geom_tile(aes(fill = bond)) +
scale_fill_gradient2(low = "tomato", mid = "steelblue1", high = "black", midpoint = 85) +
geom_contour(aes(z = bond), color = "white", binwidth = 10)
print_formula <- "Print ~ " |> str_c(x_formula)
mod_print <- lm(print_formula, data = ccd_df)
mod_print |> summary()
tibble(
actual_print = ccd_df$Print,
predicted_print = predict(mod_print)
) |>
ggplot(aes(x = actual_print, y = predicted_print)) +
geom_abline(slope = 1, intercept = 0, color = "black") +
geom_smooth(col = "black", method = "lm", formula = 'y ~ x') +
geom_point(col = "steelblue1") +
xlab("Observed print") + ylab("Predicted print")
center_repetitions <-
ccd_df |>
group_by(Temperature, Time, Pressure) |>
mutate(mean_print = mean(Print), residuals = Print - mean_print, n = n()) |>
filter(n > 1) |> ungroup()
tibble(
residuals = mod_print$residuals,
predicted_print = predict(mod_print)
) |>
ggplot(aes(x = predicted_print, y = residuals)) +
geom_hline(yintercept = 0, color = "black") +
geom_hline(data = center_repetitions, aes(yintercept = residuals), col = "tomato", linetype = 2) +
geom_smooth(col = "black", method = "lm", formula = 'y ~ x') +
geom_point(col = "steelblue1") +
xlab("Predicted print") + ylab("Residuals")
pure_error <-
ccd_df |>
group_by(Temperature, Time, Pressure) |>
mutate(
mean_print = mean(Print),
residuals = Print - mean_print
) |>
summarise(n = n(), SSE = sum(residuals^2), df = n-1, .groups = "drop") |>
filter(n > 1) |>
mutate(source = "pure error") |>
select(source, df, SSE)
lack_of_fit <-
tibble(
source = "lack of fit",
df = nrow(ccd_df) - length(mod_print$coefficients) - pure_error$df,
SSE = sum(mod_print$residuals^2) - pure_error$SSE
)
model_residuals <-
tibble(
source = "model residuals",
SSE = sum(mod_print$residuals^2),
df = mod_print$df.residual
)
bind_rows(pure_error, lack_of_fit, model_residuals) |>
mutate(MSE = SSE/df) |>
mutate(
F_stat = ifelse(source == "lack of fit", MSE/lag(MSE), NA),
p_value = pf(F_stat, df[1], df[2], lower.tail = F)
) |> pander()
newdata <-
newdata |>
mutate(
print = predict(mod_print, newdata = newdata)
)
newdata |>
ggplot(aes(x = Temperature, y = Time)) +
geom_tile(aes(fill = print)) +
scale_fill_gradient(low = "tomato", high = "steelblue1") +
geom_contour(aes(z = print), color = "white", binwidth = 0.25)
plot_ly(x = unique(newdata$Temperature), y = unique(newdata$Time), z = print_wide) |>
add_surface() |>
layout(
scene =
list(
xaxis = list(title = "Temperature"),
yaxis = list(title = "Time"),
zaxis = list(title = "Print quality")
)
)
g <-
newdata |>
ggplot(aes(x = Temperature, y = Time)) +
geom_contour_filled(aes(z = bond), binwidth = 5) +
geom_contour(aes(z = print), color = "white", binwidth = 0.1) +
geom_point(data = newdata |> filter(print == max(print)), col = "white", size = 3, shape = 4)
g
g <-
newdata |>
ggplot(aes(x = Temperature, y = Time)) +
geom_contour_filled(aes(z = bond), binwidth = 5) +
geom_contour(aes(z = print), color = "white", binwidth = 0.1) +
geom_point(data = newdata |> filter(print == max(print)), col = "white", size = 3, shape = 4)
g
delta <- 0.5
optimum <-
newdata |>
filter(bond >= 85 - delta, bond <= 85 + delta) |>
filter(print == max(print))
optimum |> pander()
g +
geom_hline(yintercept = optimum$Time, linetype = 2) +
geom_vline(xintercept = optimum$Temperature, linetype = 2) +
geom_point(data = optimum, size = 3)
predict(mod_bond, newdata = optimum)
predict(mod_bond, newdata = optimum, se.fit = TRUE)
?predict
predict(mod_bond, newdata = optimum, type = "prediction")
predict(mod_bond, newdata = optimum, interval = "prediction")
predict(mod_bond, newdata = optimum, interval = "prediction")
optimum |>
mutate(
bond_PI_low = predict(mod_bond, newdata = optimum, interval = "prediction")[1],
bond_PI_high = predict(mod_bond, newdata = optimum, interval = "prediction")[2],
print_PI_low = predict(mod_print, newdata = optimum, interval = "prediction")[1],
print_PI_high = predict(mod_print, newdata = optimum, interval = "prediction")[2]
)
optimum |>
mutate(
bond_PI_low = predict(mod_bond, newdata = optimum, interval = "prediction")[1],
bond_PI_high = predict(mod_bond, newdata = optimum, interval = "prediction")[2],
print_PI_low = predict(mod_print, newdata = optimum, interval = "prediction")[1],
print_PI_high = predict(mod_print, newdata = optimum, interval = "prediction")[2]
) |>
select(Temperature, Time, Pressure, starts_with("bond"), starts_with("print"))
optimum <-
optimum |>
mutate(
bond_PI_low = predict(mod_bond, newdata = optimum, interval = "prediction")[1],
bond_PI_high = predict(mod_bond, newdata = optimum, interval = "prediction")[2],
print_PI_low = predict(mod_print, newdata = optimum, interval = "prediction")[1],
print_PI_high = predict(mod_print, newdata = optimum, interval = "prediction")[2]
) |>
select(Temperature, Time, Pressure, starts_with("bond"), starts_with("print"))
optimum |> pander()
optimum <-
optimum |>
mutate(
bond_PI_low = predict(mod_bond, newdata = optimum, interval = "prediction")[2],
bond_PI_high = predict(mod_bond, newdata = optimum, interval = "prediction")[3],
print_PI_low = predict(mod_print, newdata = optimum, interval = "prediction")[2],
print_PI_high = predict(mod_print, newdata = optimum, interval = "prediction")[3]
) |>
select(Temperature, Time, Pressure, starts_with("bond"), starts_with("print"))
optimum |> pander()
x_formula <- "Temperature + Time + Pressure + Temperature:Time + Temperature:Pressure + Time:Pressure + I(Temperature^2) + I(Time^2) + I(Pressure^2)"
CCD <- rsm::ccd(
basis = 3, n0 = c(3,0), randomize = F, alpha = "faces",
coding = list (
x1 ~ rescale(Temperature, from = c(120, 180), to = c(-1,1)),
x2 ~ rescale(Time, from = c(0.2, 2), to = c(-1,1)),
x3 ~ rescale(Pressure, from = c(50, 150), to = c(-1,1))
)
)
CCD
ccd_df <- read_delim("data/CCD_17.csv", delim = ";")
ccd_df |> View()
10 * ccd_df$Print |> min() |> floor()
10 * ccd_df$Print |> min()
seq((10 * ccd_df$Print) |> min() |> floor(), (10 * ccd_df$Print) |> max() |> ceiling(), by = 1)
seq((10 * ccd_df$Print) |> min() |> floor(), (10 * ccd_df$Print) |> max() |> ceiling())
bond_colors <- colorRampPalette(colors = c("red4","tomato", "steelblue1", "black", "black"))(85*2)
print_colors <- colorRampPalette(colors = c("red4", "tomato", "steelblue1"))(50)
j_bond <- seq(ccd_df$Bond |> min() |> floor(), ccd_df$Bond |> max() |> ceiling())
j_print <- seq((10 * ccd_df$Print) |> min() |> floor(), (10 * ccd_df$Print) |> max() |> ceiling())
ccd_df |>
plot_ly(
type = "scatter3d", mode = "markers",
x = ~Temperature, y = ~Time, z = ~Pressure,
color = ~Bond, colors = bond_colors[j_bond],
text = ~paste0("Bond: ", Bond,"\nPrint: ", Print)
) |>
add_text(text = ~Trial_number, color = I("black"), showlegend = F) |>
layout(
scene =
list(
xaxis = list(range = c(120, 180)),
yaxis = list(range = c(0.2, 2)),
zaxis = list(range = c(50, 150), tickvals = seq(50, 150, by = 25))
)
)
ccd_df |>
plot_ly(
type = "scatter3d", mode = "markers",
x = ~Temperature, y = ~Time, z = ~Pressure,
color = ~Print, colors = print_colors[j_print],
text = ~paste0("Bond: ", Bond,"\nPrint: ", Print)
) |>
add_text(text = ~Trial_number, color = I("black"), showlegend = F) |>
layout(
scene =
list(
xaxis = list(range = c(120, 180)),
yaxis = list(range = c(0.2, 2)),
zaxis = list(range = c(50, 150), tickvals = seq(50, 150, by = 25))
)
)
ccd_df |>
plot_ly(
type = "scatter3d", mode = "markers",
x = ~Temperature, y = ~Time, z = ~Pressure,
color = ~Bond, colors = bond_colors[j_bond],
text = ~paste0("Bond: ", Bond,"\nPrint: ", Print)
) |>
add_text(text = ~Trial_number, color = I("black"), showlegend = F) |>
layout(
scene =
list(
xaxis = list(range = c(120, 180)),
yaxis = list(range = c(0.2, 2)),
zaxis = list(range = c(50, 150), tickvals = seq(50, 150, by = 25))
)
) +
ccd_df |>
plot_ly(
type = "scatter3d", mode = "markers",
x = ~Temperature, y = ~Time, z = ~Pressure,
color = ~Print, colors = print_colors[j_print],
text = ~paste0("Bond: ", Bond,"\nPrint: ", Print)
) |>
add_text(text = ~Trial_number, color = I("black"), showlegend = F) |>
layout(
scene =
list(
xaxis = list(range = c(120, 180)),
yaxis = list(range = c(0.2, 2)),
zaxis = list(range = c(50, 150), tickvals = seq(50, 150, by = 25))
)
)
print_formula <- "Print ~ " |> str_c(x_formula)
mod_print <- lm(print_formula, data = ccd_df)
mod_print |> summary()
val_df <- read_delim("data/Validation_3 .csv", delim = ";")
df <-
bind_rows(
ccd_df |> mutate(type = "experiment"),
val_df |> mutate(type = "validation")
) |>
mutate(trial = row_number() |> factor())
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85 + c(-1, 1), linetype = 3) +
geom_point(size = 2)  +
df |>
ggplot(aes(x = trial, y = Print, col = type)) +
geom_point(size = 2)  +
plot_layout(guides = "collect")
# df |>
#   pivot_longer(cols = c(Bond, Print), names_to = "response", values_to = "value") |>
#   ggplot(aes(x = n, y = value, col = type)) +
#   geom_point() +
#   facet_grid(response ~ ., scales = "free_y")
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85 + c(-1, 1), linetype = 3) +
geom_point(size = 2)  +
df |>
ggplot(aes(x = trial, y = Print, col = type)) +
geom_point(size = 2)  +
plot_layout(guides = "collect")
df <-
bind_rows(
ccd_df |> mutate(type = "experiment"),
val_df |> mutate(type = "validation")
) |>
mutate(trial = row_number() |> factor())
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = c(optimum$bond_PI_low, optimum$bond_PI_high), linetype = 3) +
geom_point(size = 2)  +
df |>
ggplot(aes(x = trial, y = Print, col = type)) +
geom_point(size = 2)  +
plot_layout(guides = "collect")
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = c(optimum$bond_PI_low, optimum$bond_PI_high), linetype = 3) +
geom_point(size = 2)  +
df |>
ggplot(aes(x = trial, y = Print, col = type)) +
geom_hline(yintercept = c(optimum$print_PI_low, optimum$print_PI_high), linetype = 3) +
geom_point(size = 2)  +
plot_layout(guides = "collect")
df |>
ggplot(aes(x = trial, y = Bond, col = type)) +
geom_hline(yintercept = 85, linetype = 2) +
geom_hline(yintercept = c(optimum$bond_PI_low, optimum$bond_PI_high), linetype = 3) +
geom_point(size = 2)  +
df |>
ggplot(aes(x = trial, y = Print, col = type)) +
geom_hline(yintercept = c(optimum$print_PI_low, optimum$print_PI_high), linetype = 3) +
geom_point(size = 2)  +
plot_layout(guides = "collect")
x_formula <- "Temperature + Time + Pressure + Temperature:Time + Temperature:Pressure + Time:Pressure + I(Temperature^2) + I(Time^2) + I(Pressure^2)"
CCD <- rsm::ccd(
basis = 3, n0 = c(3,0), randomize = F, alpha = "faces",
coding = list (
x1 ~ rescale(Temperature, from = c(120, 180), to = c(-1,1)),
x2 ~ rescale(Time, from = c(0.2, 2), to = c(-1,1)),
x3 ~ rescale(Pressure, from = c(50, 150), to = c(-1,1))
)
)
CCD
